home *** CD-ROM | disk | FTP | other *** search
Text File | 1997-07-08 | 64.0 KB | 1,992 lines |
- ;$Id: d_venn.pro,v 1.14 1997/04/23 15:02:01 ghayman Exp $
- ;
- ; Copyright (c) 1997, Research Systems, Inc. All rights reserved.
- ; Unauthorized reproduction prohibited.
- ;
- ;+
- ; FILE:
- ; d_venn.pro
- ;
- ; CALLING SEQUENCE: d_venn
- ;
- ; PURPOSE:
- ; Visualize the result of set theory operations through
- ; Venn diagrams.
- ;
- ; MAJOR TOPICS: Visualization
- ;
- ; CATEGORY:
- ; IDL 5.0
- ;
- ; INTERNAL FUNCTIONS and PROCEDURES:
- ; pro PlotCircle - Plot a circle
- ; pro PlaceVennLegend - Place the legend
- ; pro DrawVennDiagram - Draw the Venn diagram
- ; fun SetsIntersect - Obtain the intersection of two sets
- ; fun SetsSubtract - Obtain the subtraction of two sets
- ; fun SetsUnion - Obtain the union of two sets
- ; pro DataViewerHandler - Event handler for viewing data
- ; fun DataViewer - View the data set
- ; fun TypeOf - Find the data type of a variable
- ; fun ValidSetData - Determine the validity of a set
- ; pro LoadCalcBitmap - Load the bitmaps buttons
- ; pro CreateSet - Create a new set
- ; fun DoSetOp - Do the set operation
- ; fun ModifyCalcText - Modify the calculator text
- ; pro SetCalcButtonHandler - Event handler for calculator button
- ; pro SetCalcHandleEvents - Event handler for calculator
- ; other than button
- ; pro CleanupVenn - Cleanup
- ; pro VennHandleEvent - Main event handler
- ; pro D_Venn - Main procedure
- ;
- ; EXTERNAL FUNCTIONS, PROCEDURES, and FILES:
- ; sets__define.pro - Class definition file for the 'sets' class
- ;
- ; REFERENCE: IDL Reference Guide, IDL User's Guide
- ;
- ; NAMED STRUCTURES:
- ; NONE
- ;
- ; COMMON BLOCS:
- ; NONE
- ;
- ; MODIFICATION HISTORY:
- ; 3/97, GH, SK - Written.
- ;-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Plot circles for Venn diagrams.
- ;
- pro PlotCircle, $
- radius, $ ; IN: circle radius in pixels
- position, $ ; IN: x and y position of the circle
- NOERASE = noErase, $ ; IN: (opt) Erase previous plot (0=no,1=yes)
- COLOR = color ; IN: (opt) Color index to fill the circle
-
- if (not (KEYWORD_SET (noErase))) then $
- noErase = 0
-
- position[0] = 0.99999 * position[0]
- position[1] = 0.99999 * position[1]
- position[2] = 1.00009 * position[2]
- position[3] = 1.00009 * position[3]
- ro = FLTARR(180) + radius
- to = FINDGEN(180) * 4.0 * !PI / 180.0
-
- PLOT, ro, to, /POLAR, /DEVICE, POSITION=position, $
- XSTYLE=5, YSTYLE=5, NOERASE=noErase, COLOR=color, $
- THICK=1.2
-
- end
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Local procedure to place legends for
- ; Venn Diagrams.
- ;
- pro PlaceVennLegend, xWinSize, yWinSize, nameC, nameA, nameB, $
- CURRDEV = gID, COLORS = colors, FLIPFLAG = flipFlag
- if (N_PARAMS() LE 2) then begin
- RETURN
- endif else begin
-
- WSET, gID
- ; Compute handy offset values.
- ;
- fivPerX = ROUND(xWinSize / 20.0)
- fivPerY = ROUND(yWinSize / 20.0)
- tenPerX = 2 * fivPerX
- tenPerY = 2 * fivPerY
-
- ; Name swap if necessary
- ;
- if ((flipFlag) and (N_PARAMS() EQ 5)) then begin
- ; Swap the names.
- ;
- tmp = nameA
- nameA = nameB
- nameB = tmp
- endif
-
- if (N_PARAMS() EQ 5) then begin
-
- ; Three items needed in legend.
- ; Create legend for result (C) set.
- ;
- xFill1 = [fivPerX,tenPerX,tenPerX,fivPerX]
- yFill1 = [fivPerY,fivPerY,tenPerY,tenPerY] - 4
- POLYFILL, xFill1, yFill1, /DEVICE, COLOR = colors[0]
- XYOUTS, 2*fivPerX+4, fivPerY, /DEVICE, COLOR = colors[3], $
- 'Set ' + nameC
-
- ; Create legend for first (A) set.
- ;
- xFill2 = 3 * tenPerX + fivPerX + xFill1
- POLYFILL, xFill2, yFill1, /DEVICE, COLOR=colors[1]
- XYOUTS, 4 * tenPerX + fivPerX + 4, fivPerY, /DEVICE, $
- COLOR=colors[3], 'Set ' + nameA
-
- ; Create legend for second (B) set.
- ;
- xFill3 = 7 * tenPerX + xFill1
- POLYFILL, xFill3, yFill1, /DEVICE, COLOR = colors[2]
- XYOUTS, 8 * tenPerX + 4, fivPerY, /DEVICE, $
- COLOR = colors[3], 'Set ' + nameB
-
- endif else if (N_PARAMS() EQ 3) then begin
-
- ; One item needed in legend.
- ; Create legend for result (C) set.
- ;
- xFill1 = [fivPerX,tenPerX,tenPerX,fivPerX]
- yFill1 = [fivPerY,fivPerY,tenPerY,tenPerY] - 4
- POLYFILL, xFill1, yFill1, /DEVICE, COLOR=colors[0]
- XYOUTS, 2*fivPerX+4, fivPerY, /DEVICE, COLOR=colors[3], $
- 'Set ' + nameC
-
- endif
-
- endelse
-
- end
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Plot a Venn Diagram.
- ; In this procedure, circular areas are used
- ; to show the relative number of unique set members
- ; in the incoming sets sA and sB. Intersection
- ; areas are show proportionately as circular secant
- ; sectors where the shaded area indicates the amount
- ; of sC shared between sA and sB.
- ;
- pro DrawVennDiagram, $
- sA, sB, sC, $ ; IN: sets A, B, and C
- nameA, nameB, nameC, $ ; IN: names of sets A, B, and C
- opString, $ ; IN: operation string(Substraction, etc..)
- gID, $ ; IN: Window (graphics) ID
- COLORS = colors
-
- ; In this procedure, circular areas are used to show the relative number
- ; of unique set members in the incoming sets sA and sB. Intersection
- ; areas are show proportionately as circular secant sectors where the
- ; shaded area indicates the amount of sC shared between sA and sB.
- ;
- ; Error catching, return to previous function.
- ;
- ; ON_ERROR, 2
-
-
- ; Check on the number of parameters, must have full set.
- ;
- if (N_PARAMS() ne 8) then $
- MESSAGE, 'ERROR: DrawVennDiagram requires 8 positional paramaters.'
-
- ; Set the current window to the graphics display.
- ;
- WSET, gID
- ERASE
- xWinSize = !D.X_SIZE ; Get display window x-size
- yWinSize = !D.Y_SIZE ; .. y-size
-
- ; Set a flag to keep track of the larger of the 2 circles in display.
- ; Open a pixmap window to store the image to be "flipped."
- ;
- if (sA gt sB) then $
- flipFlag = 0 $
- else $
- flipFlag = 1
-
- ; Look for sets which were loaded by the user or the program
- ; at the start.
- ;
- if opString EQ '' then begin
- r1 = .30 * (xWinSize < yWinSize)
- xoff = (xWinSize - 2*r1) / 2
- yoff = (yWinSize - 2*r1) / 2
-
- ; Create appropriate polygons for display (sets A and B; circles). .
- ;
- thetas1 = INDGEN(201) * !PI * 2.0 / 200.0
- ax = r1 * COS(thetas1) + r1 + xoff
- ay = r1 * SIN(thetas1) + r1 + yoff
- POLYFILL, ax, ay, /DEVICE, COLOR = colors[0]
- PlaceVennLegend, xWinSize, yWinSize, nameC, $
- currDev = gID, COLORS = colors, FLIPFLAG = flipFlag
- RETURN
- endif
-
- ; Look for operations which result in the Empty Set.
- ;
- if (sC EQ 0) then begin
- mtString = 'OPERATION PRODUCED THE EMPTY SET'
- mtStringLength = STRLEN(mtString)
- mtX = ROUND((xWinSize - $
- FLOAT(mtStringLength * !D.X_CH_SIZE)) / 2.0)
- mtY = ROUND((yWinSize - FLOAT(!D.Y_CH_SIZE)) / 2.0)
- mtX = 10 ;Ten pixel offset.
- XYOUTS, mtX, mtY, mtString, /DEVICE, COLOR = colors[3]
- return
- endif
-
- ; If one of the two operators is the Empty Set then do not draw a Venn.
- ;
- if ((sA EQ 0) or (sB EQ 0)) then begin
- mtString = 'NO VENN DIAGRAM FOR THIS SET'
- mtStringLength = STRLEN(mtString)
- mtX = ROUND((xWinSize - $
- FLOAT(mtStringLength * !D.X_CH_SIZE)) / 2.0)
- mtY = ROUND((yWinSize - FLOAT(!D.Y_CH_SIZE)) / 2.0)
- mtX = 10 ;Ten pixel offset.
- XYOUTS, mtX, mtY, mtString, /DEVICE, COLOR = colors[3]
- return
- endif
-
-
- ; Determine the controlling display diameter (in the y-direction) or the
- ; controlling sum of the diameters (in the x-direction) to scale the
- ; display. Venn "circles" are plotted side-by-side in x-direction.
- ;
- smallSet = sA < sB ;smaller of the two incoming sets
- largeSet = sA > sB ;larger ..
-
- ; Use either 80 percent of the xWinSize or 60 percent of the yWinSize.
- ; The y-direction is reduced to leave room for the legend.
- ;
- r1 = (0.4 * xWinSize - SQRT(sB/!PI)) < (0.30 * yWinSize)
- area1 = !PI * r1^2
- area2 = area1 * smallSet / largeSet
- r2 = SQRT(area2 / !PI)
-
- ; Set up a distance (between the circle centerpoints) variable for use
- ; in all cases.
- ;
- b = 0.0
-
- ; For all operations, INTERSECTION, SUBTRACTION and UNION,
- ; create an overlay of the circles if sC is not equal to zero.
- ;
- ; Determine the polygons associated with the area ratios based on the
- ; intersection of sets A and B (sA and sB). The formula is nonlinear so
- ; use an incremental solution.
- ;
- ; Calculate Intersecting area.
- ;
- case (STRUPCASE(opString)) of
- 'INTERSECTION' : sI = sC
- 'SUBTRACTION' : sI = sA - sC
- 'UNION' : sI = sA + sB - sC
- endcase
-
- realFrac = FLOAT(sI) / largeSet
- frac = 0.0
- a = 0.0
- while (frac lt realFrac) do begin
-
- a = a + 0.1 ;increment
- b = r1 + r2 - a ;distance between center points of sA and sB circles
-
- if (ABS(b) ge 10.0^(-4)) then $
-
- ; Local intersection x coordinate
- ;
- x1 = (b^2 + r1^2 - r2^2) / (2.0 * b) $
- else begin
-
- ; Limit case
- ;
- x1 = (b + r1^2 - r2^2) / 2.0
- endelse
- y1 = SQRT((r1^2 - x1^2) > 0.0) ;local intersection y coordinate
-
- theta1 = ASIN((y1 / r1) < 1.0) ;angle to intersect of circs (large)
- theta2 = ASIN((y1 / r2) < 1.0) ;angle to intersect of circs (small)
-
- ; Determine fractional areas of overlayed circles (summation of the
- ; areas of the 2 secant circular sectors).
- ;
- p1 = r1^2 * theta1 - x1 * y1
- if x1 lt b then $
- p2 = r2^2 * theta2 - ((b-x1) * y1) $
- else $
- p2 = r2^2 * (!PI - theta2) + ((x1-b) * y1)
-
- areaI = p1 + p2
- frac = areaI / area1
-
- endwhile
-
- ; Set current graphics ID to passed-in value.
- ;
- WSET, gID
-
- ; Begin testing for display types (two circles/two partially overlayed
- ; circles/two fully overlayed circles/single circle).
- ;
- ; No overlay
- ;
- if (sI EQ 0) then begin
-
- xoff = FIX((xWinSize - 2.0 * r1 - 2.0 * r2) / 4.0)
- yoff = FIX((yWinSize - 2.0 * r1) / 2.0)
- noSkip = 1 ; Go ahead and draw circles unless this changes.
-
- ; Create appropriate polygons for display (sets A and B; circles).
- ;
- thetas1 = INDGEN(201) * !PI * 2.0 / 200.0
- ax = r1 * COS(thetas1) + r1 + xoff
- ay = r1 * SIN(thetas1) + r1 + yoff
- bx = r2 * COS(thetas1) + xWinSize - xoff - r2
- by = r2 * SIN(thetas1) + r1 + yoff
-
- if (flipFlag) then begin
- ax = xWinSize - ax
- bx = xWinSize - bx
- endif
-
- case (STRUPCASE(opString)) of
-
- 'INTERSECTION' : begin
- ; Create a warning string for the empty set.
- ;
- mtString = 'OPERATION PRODUCED THE EMPTY SET'
- mtStringLength = STRLEN(mtString)
- mtX = ROUND((xWinSize - $
- FLOAT(mtStringLength * !D.X_CH_SIZE)) / 2.0)
- mtY = ROUND((yWinSize - FLOAT(!D.Y_CH_SIZE)) / 2.0)
- mtX = 10 ;Ten pixel offset
- XYOUTS, mtX, mtY, mtString, /DEVICE, COLOR = colors[0]
- noSkip = 0 ;Skip plotting circles.
- end
-
- 'SUBTRACTION' : begin
- if (flipFlag) then $
- POLYFILL, bx, by, /DEVICE, COLOR = colors[0] $
- else $
- POLYFILL, ax, ay, /DEVICE, COLOR = colors[0]
- end
-
- 'UNION' : begin
- POLYFILL, ax, ay, /DEVICE, COLOR = colors[0]
- POLYFILL, bx, by, /DEVICE, COLOR = colors[0]
- end
-
- endcase
-
- if (noSkip) then begin
- position = [xoff,yoff,2 * r1 + xoff,2 * r1 + yoff]
- if (flipFlag) then begin
- temp = position[0]
- position[0] = xWinSize - position[2]
- position[2] = xWinSize - temp
- endif
- PlotCircle, r1, position, /NOERASE, COLOR = colors[1]
- xl = xWinSize - xoff - 2.0 * r2
- xr = xl + 2.0 * r2
- position = [xl, yoff + r1 - r2, $
- xr, yoff + r1 + r2]
- if (flipFlag) then begin
- temp = position[0]
- position[0] = xWinSize - position[2]
- position[2] = xWinSize - temp
- endif
- PlotCircle, r2, position, /NOERASE, COLOR = colors[2]
- endif
-
- ; 2 partially overlayed.
- ;
- endif else if ((sI gt 0) and (sI lt (sA < sB))) then begin
-
- xoff = FIX((xWinSize - r1 - r2 - b) / 2.0)
- yoff = FIX((yWinSize - 2.0 * r1) / 2.0)
-
- ; Create appropriate polygons for display (sets A and B circles
- ; minus their respective intersection polygon).
- ;
-
- thetas1 = INDGEN(201) * theta1 * 2.0 / 200.0 - theta1
- xa = r1 * COS(thetas1) + r1
- ya = r1 * SIN(thetas1) + r1
-
- if (b gt x1) then $
- thetas2 = INDGEN(201) * theta2 * 2.0 / 200.0 - theta2 $
- else $
- thetas2 = INDGEN(201) * (!PI - theta2) * 2.0 / 200.0 $
- - (!PI - theta2)
- xb = -r2 * COS(thetas2) + b + r1
- yb = r2 * SIN(thetas2) + r1
-
- thetas3 = INDGEN(201) * (2.0 * !PI - 2.0 * theta1) / 200.0 + $
- theta1
- xc = r1 * COS(thetas3) + r1
- yc = r1 * SIN(thetas3) + r1
- if (b gt x1) then $
- thetas4 = INDGEN(201) * (2.0 * !PI - 2.0 * theta2) / 200.0 + $
- theta2 $
- else $
- thetas4 = INDGEN(201) * (2.0 * !PI - 2.0 * (!PI - theta2)) $
- / 200.0 + (!PI - theta2)
-
- xd = -r2 * COS(thetas4) + b + r1
- yd = r2 * SIN(thetas4) + r1
-
- ix = [REVERSE(xa),xb] + xoff
- iy = [REVERSE(ya),yb] + yoff
-
- ax = [xc,xb] + xoff
- ay = [yc,yb] + yoff
- bx = [xd,xa] + xoff
- by = [yd,ya] + yoff
- if (flipFlag) then begin
- ax = xWinSize - ax
- bx = xWinSize - bx
- ix = xWinSize - ix
- endif
-
- case STRUPCASE(opString) of
-
- 'INTERSECTION' : begin
- POLYFILL, ix, iy, /DEVICE, COLOR=colors[0]
- end
-
- 'SUBTRACTION' : begin
- if (flipFlag) then $
- POLYFILL, bx, by, /DEVICE, COLOR=colors[0] $
- else $
- POLYFILL, ax, ay, /DEVICE, COLOR=colors[0]
- end
-
- 'UNION' : begin
- POLYFILL, ix, iy, /DEVICE, COLOR = colors[0]
- POLYFILL, ax, ay, /DEVICE, COLOR = colors[0]
-
- POLYFILL, bx, by, /DEVICE, COLOR = colors[0]
- end
-
- endcase
-
- position = [xoff,yoff,2 * r1 + xoff,2 * r1 + yoff]
- if (flipFlag) then begin
- temp = position[0]
- position[0] = xWinSize - position[2]
- position[2] = xWinSize - temp
- endif
- PlotCircle, r1, position, /NOERASE, COLOR=colors[1]
-
- position = [xoff + b + r1 - r2,yoff + r1 - r2, $
- xoff + b + r1 + r2,yoff + r1 + r2]
- if (flipFlag) then begin
- temp = position[0]
- position[0] = xWinSize - position[2]
- position[2] = xWinSize - temp
- endif
-
- PlotCircle, r2, position, /NOERASE, COLOR=colors[2]
-
- endif else if (sI EQ (sA < sB)) then begin
-
- xoff = FIX((xWinSize - 2.0 * r1) / 2.0)
- yoff = FIX((yWinSize - 2.0 * r1) / 2.0)
- noSkip = 1 ; Go ahead and draw circles unless this changes.
-
- ; Create appropriate polygons for display (sets A and B; circles).
- ;
- thetas1 = INDGEN(201) * !PI * 2.0 / 200.0
- ax = r1 * COS(thetas1) + r1 + xoff
- ay = r1 * SIN(thetas1) + r1 + yoff
- bx = r2 * COS(thetas1) + r1 + xoff + (r1 - r2) / 2.0
- by = r2 * SIN(thetas1) + r1 + yoff
- if (flipFlag) then begin
- ax = xWinSize - ax
- bx = xWinSize - bx
- endif
-
-
- case (STRUPCASE(opString)) of
-
- 'INTERSECTION' : begin
- POLYFILL, bx, by, /DEVICE, COLOR=colors[0]
- end
-
- 'SUBTRACTION' : begin
- if (flipFlag) then begin
- ; Create a warning string for the empty set.
- ;
- mtString = 'OPERATION PRODUCED THE EMPTY SET'
- mtStringLength = STRLEN(mtString)
- mtX = ROUND((xWinSize - $
- FLOAT(mtStringLength * !D.X_CH_SIZE)) / 2.0)
- mtY = ROUND((yWinSize - FLOAT(!D.Y_CH_SIZE)) / 2.0)
- mtX = 10 ;Ten pixel offset
- XYOUTS, mtX, mtY, mtString, /DEVICE, COLOR = colors[3]
- noSkip = 0 ;Skip plotting circles.
- endif else begin
- POLYFILL, ax, ay, /DEVICE, COLOR = colors[0]
- POLYFILL, bx, by, /DEVICE, COLOR = !P.BACKGROUND
- endelse
- end
-
- 'UNION' : begin
- POLYFILL, ax, ay, /DEVICE, COLOR=colors[0]
- POLYFILL, bx, by, /DEVICE, COLOR=colors[0]
- end
-
- endcase
-
- if (noSkip) then begin
- position = [xoff,yoff,2 * r1 + xoff,2 * r1 + yoff]
- if (flipFlag) then begin
- temp = position[0]
- position[0] = xWinSize - position[2]
- position[2] = xWinSize - temp
- endif
-
- PlotCircle, r1, position, /NOERASE, COLOR=colors[1]
- xl = xoff + 3.0 * (r1 - r2) / 2.0
- xr = xl + 2.0 * r2
- position = [xl, yoff + r1 - r2, $
- xr, yoff + r1 + r2]
- if (flipFlag) then begin
- temp = position[0]
- position[0] = xWinSize - position[2]
- position[2] = xWinSize - temp
- endif
-
- PlotCircle, r2, position, /NOERASE, COLOR = colors[2]
- endif
-
- endif else if ((sI EQ sA) and (sI EQ sB)) then begin
-
- xoff = FIX((xWinSize - 2.0 * r1) / 2.0)
- yoff = FIX((yWinSize - 2.0 * r1) / 2.0)
-
- ; Create appropriate polygons for display (sets A and B; circles).
- ;
- thetas1 = INDGEN(201) * !PI * 2.0 / 200.0
- ax = r1 * COS(thetas1) + r1 + xoff
- ay = r1 * SIN(thetas1) + r1 + yoff
- if (flipFlag) then begin
- ax = xWinSize - ax
- endif
-
-
- case (STRUPCASE(opString)) of
-
- 'INTERSECTION' : begin
- POLYFILL, ax, ay, /DEVICE, COLOR=colors[0]
- end
-
- 'SUBTRACTION' : begin
- ; Create a warning string for the empty set.
- ;
- mtString = 'OPERATION PRODUCED THE EMPTY SET'
- mtStringLength = STRLEN(mtString)
- mtX = ROUND((xWinSize - $
- FLOAT(mtStringLength * !D.X_CH_SIZE)) / 2.0)
- mtY = ROUND((yWinSize - FLOAT(!D.Y_CH_SIZE)) / 2.0)
- mtX = 10 ;Ten pixel offset.
- XYOUTS, mtX, mtY, mtString, /DEVICE, COLOR = colors[3]
- noSkip = 0 ;Skip plotting circles.
- end
-
- 'UNION' : begin
- POLYFILL, ax, ay, /DEVICE, COLOR=colors[0]
- end
-
-
- endcase
-
- if (noSkip) then begin
- position = [xoff,yoff,2 * r1 + xoff,2 * r1 + yoff]
-
- if (flipFlag) then begin
- temp = position[0]
- position[0] = xWinSize - position[2]
- position[2] = xWinSize - temp
- endif
-
- PlotCircle, r1, position, /NOERASE, COLOR=colors[1]
- endif
-
- endif
-
- ; Display total Venn legend if procedure makes it to this point.
- ;
- PlaceVennLegend, xWinSize, yWinSize, nameC, nameA, nameB, $
- currDev = gID, COLORS = colors, FLIPFLAG = flipFlag
-
-
- end
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Obtain the intersection of two sets.
- ;
- function SetsIntersect, origA, origB, delta, Count = count , $
- Digits = digits, Factor = factor
-
- if N_PARAMS() lt 2 then $
- MESSAGE, "Requires two arguments"
- if N_PARAMS() eq 2 then $
- delta = 0 $
- else $
- if delta LT 0 then $
- MESSAGE, "DELTA must be >= zero"
-
- ; Handle EMPTY set as argument
- ;
- if ((N_ELEMENTS(origA) eq 0) or (N_ELEMENTS(origB) eq 0)) then begin
- count = 0
- return, -1
- endif
-
- ; Determine Datatype of A and B arrays and force them to be 1D arrays if necessary.
- ; Also create copies of the original inputs.
- dimA = (Size(origA))[0]
- dimB = (Size(origB))[0]
- if (dimA eq 0) then $
- a = REPLICATE(origA, 1) $
- else if (dimA gt 1) then $
- a = REFORM(origA, N_ELEMENTS(origA)) $
- else $
- a = origA
-
- if (dimB eq 0) then $
- b = REPLICATE(origB, 1) $
- else if (dimB gt 1) then $
- b = REFORM(origB, N_ELEMENTS(origB)) $
- else $
- b = origB
-
- dtA = (Size(origA))[2]
- dtB = (Size(origB))[2]
-
-
-
- idelta = delta
- factor = 1
-
- if ((dtA ge 4) or (dtB ge 4)) then begin ; Float?
-
- if (idelta ne 0) then begin
- ; Determine the scale factor needed to convert floats to integers.
- idelta = idelta* factor
- while ((idelta) - FIX(idelta)) ne 0 do begin
- factor = factor * 10.
- if factor eq 1e8 then $
- MESSAGE, 'Too many significant digits'
- idelta = delta * factor ; Determine the integer-based DELTA
- endwhile
-
- idelta = Fix(idelta)
- endif
-
- if Keyword_Set(digits) then begin
- if digits ge 8 then $
- Message, 'Too many significant digits'
- if (10. * digits) gt factor then begin
- factor = 10. ^ digits
- idelta = factor * delta
- endif
- Help,idelta, factor
- endif else if idelta eq 0 then begin
- factor = 1000.
- idelta = factor*delta
- Help,idelta, factor
- endif
-
- ; Create integer versions of A and B
- a = ROUND(TEMPORARY(a) * factor)
- ;Help,a
- b = ROUND(TEMPORARY(b) * factor)
- endif else begin ; Byte or Integers
- if ((idelta) - Fix(idelta)) ne 0 then $
- Message, 'DELTA must be an integer when A and B are not of type FLOAT or DOUBLE'
- endelse
-
- offset = (MIN(a) - idelta) < MIN(b)
- num = ((MAX(a) + idelta) > MAX(b)) - offset + 1
- a = TEMPORARY(a) - offset
-
- ; Create a mask image based on A
- maskA = BYTARR(num)
- maskA[a] = 1B
-
- ; Create expanded mask based on DELTA
- if idelta gt 0 then begin
- minMaskA = SHIFT(maskA, -1 * idelta)
- maxMaskA = SHIFT(maskA, idelta)
- maskA = TEMPORARY(maskA) or TEMPORARY(minMaskA) or $
- TEMPORARY(maxMaskA)
- maskA = not(TEMPORARY(maskA)) - 254B
- s = BYTARR(idelta) + 1B
- maskA = DILATE(ERODE(TEMPORARY(maskA), s), s)
- s = 0B
- maskA = not( TEMPORARY(maskA)) - 254B
- endif
-
- maskB = BYTARR(num)
- b = TEMPORARY(b) - offset
- maskB[b] = 1B
- both = TEMPORARY(maskA) * TEMPORARY(maskB)
- match = WHERE(both eq 1, count)
- if count gt 0 then begin
- result = DOUBLE(match + offset) / factor
- case dtB of
- 1: return, BYTE(result)
- 2: return, FIX(result)
- 3: return, LONG(result)
- 4: return, FLOAT(result)
- 5: return, result
- endcase
- endif else begin
- return, -1
- endelse
- end
-
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Obtain the subtraction of two sets.
- ;
- function SetsSubtract, origA, origB, delta, Count = count , Digits = digits, Intersect_Size = iSize
-
- if N_PARAMS() lt 2 then $
- Message, "Requires two arguments"
- if N_PARAMS() eq 2 then $
- delta = 0 $
- else $
- if delta lt 0 then $
- MESSAGE, "DELTA must be >= zero"
-
-
-
- if (N_ELEMENTS(origA) eq 0) then begin
- count = 0
- return, -1
- endif
-
- ; Determine Datatype of A and B arrays and force them to be 1D arrays if necessary.
- ; Also create copies of the original inputs.
- dimA = (SIZE(origA))[0]
-
- if (dimA eq 0) then $
- a = REPLICATE(origA, 1) $
- else if (dimA gt 1) then $
- a = REFORM(origA, N_ELEMENTS(origA)) $
- else $
- a = origA
-
- dtA = (SIZE(origA))[2]
-
- if (N_ELEMENTS(origB) eq 0) then begin
- count = N_Elements(a)
- return, a
- endif
-
- ; Find Intersection of A and B
- c = SetsIntersect(origB, a, delta, Count = iSize, Digits = digits, $
- Factor = factor)
-
- if iSize ne 0 then begin ; Common elements?
-
- ; Create integer versions of A and C
- a = ROUND(TEMPORARY(a) * factor)
- c = ROUND(TEMPORARY(c) * factor)
-
- offset = MIN(a) < MIN(c)
- num = (MAX(a) > MAX(c)) - offset + 1
- a = TEMPORARY(a) - offset
-
- ; Create a mask images based on A and C
- maskA = BYTARR(num)
- maskA[a] = 1B
- maskC = BYTARR(num) + 1
- c = TEMPORARY(c) - offset
- maskC[c] = 0B
- both = TEMPORARY(maskA) * TEMPORARY(maskC)
- match = Where(both EQ 1, count)
-
- if (count gt 0) then begin
- result = DOUBLE(match + offset) / factor
- case dtA of
- 1: return, BYTE(result)
- 2: return, FIX(result)
- 3: return, LONG(result)
- 4: return, FLOAT(result)
- 5: return, result
- endcase
- endif else begin
- return, -1
- endelse
- endif
- count = N_ELEMENTS(a)
- return, a
- end
-
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Obtain the union of two sets.
- ;
- function SetsUnion, origA, origB, delta, Count = count , Digits = digits, Intersect_Size = iSize
-
- if (N_PARAMS() lt 2) then $
- Message, "Requires two arguments"
- if (N_PARAMS() eq 2) then $
- delta = 0 $
- else $
- if (delta lt 0) then $
- Message, "DELTA must be >= zero"
- if ((N_ELEMENTS(origA) eq 0) and (N_ELEMENTS(origB) eq 0)) then begin
- iSize = 0
- count = 0
- return, -1
- endif
-
- if (N_ELEMENTS(origA) eq 0) then begin ; Only one valid set, return it to caller.
-
- ; Determine Datatype of A and B arrays and force them to be 1D arrays if necessary.
- ; Also create copies of the original inputs.
- dimB = (Size(origB))[0]
-
- if (dimB eq 0) then $
- b = REPLICATE(origB, 1) $
- else if (dimB gt 1) then $
- b = REFORM(origB, N_ELEMENTS(origB)) $
- else $
- b = origB
- dtB = (Size(origB))[2]
-
- count = N_Elements(origB)
- iSize = 0
- return, b
- endif
-
- if (N_ELEMENTS(origB) eq 0) then begin ; Only one valid set, return it to caller.
- dimA = (Size(origA))[0]
- if (dimA eq 0) then $
- a = REPLICATE(origA, 1) $
- else if (dimA gt 1) then $
- a = REFORM(origA, N_ELEMENTS(origA)) $
- else $
- a = origA
- dtA = (Size(origA))[2]
-
- count = N_Elements(origA)
- iSize = 0
- return, a
- endif
-
- dimA = (Size(origA))[0]
- if (dimA eq 0) then $
- a = REPLICATE(origA, 1) $
- else if (dimA gt 1) then $
- a = REFORM(origA, N_ELEMENTS(origA)) $
- else $
- a = origA
- dtA = (Size(origA))[2]
- dimB = (Size(origB))[0]
- if (dimB eq 0) then $
- b = REPLICATE(origB, 1) $
- else if (dimB gt 1) then $
- b = REFORM(origB, N_ELEMENTS(origB)) $
- else $
- b = origB
- dtB = (Size(origB))[2]
-
- ; Find Intersection of A and B
- c = SetsIntersect(origB, a, delta, Count = iSize, Digits = digits, $
- Factor = factor)
- if (delta ne 0) then begin
-
- if (iSize ne 0) then begin ; Common elements?
-
- ; Create integer versions of A and B
- a = ROUND(TEMPORARY(a) * factor)
- ;Help,a
- c = ROUND(TEMPORARY(c) * factor)
-
- offset = MIN(a) < MIN(c)
- ; Print, offset
- num = (MAX(a) > MAX(c)) - offset + 1
- a = TEMPORARY(a) - offset
-
- ; Create mask images based on A and C
- maskA = BYTARR(num)
- maskA[a] = 1B
- maskC = BYTARR(num) + 1
- c = TEMPORARY(c) - offset
- maskC[c] = 0B
- both = TEMPORARY(maskA) * TEMPORARY(maskC)
- match = WHERE(both eq 1, count)
- if count gt 0 then $
- result = DOUBLE(match + offset) / factor
- endif
- endif else begin
-
- result = [REFORM(a,N_ELEMENTS(a)), REFORM(b, N_ELEMENTS(b))]
- result = result[UNIQ(result, SORT(result))]
- count = N_ELEMENTS(result)
- endelse
- if count gt 0 then begin
-
- ; Print, 'Data Type B: ', dtB
- case dtB of
- 1: return, BYTE(result)
- 2: return, FIX(result)
- 3: return, LONG(result)
- 4: return, FLOAT(result)
- 5: return, result
- endcase
- endif else begin
- return, -1
- endelse
-
- return, a
- end
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Quit this application.
- ;
- pro DataViewerHandler, $
- sEvent ; IN: event structure
-
- WIDGET_CONTROL, sEvent.top, /DESTROY
- end
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Widget program to display array data
- ; within a table widget.
- ;
- function DataViewer, $
- data, $ ; IN: Data to display.
- TITLE = title, $ ; IN: Title fo the widget table
- GROUP_LEADER = wGroup ; IN: (opt) Group leader
-
- if (N_ELEMENTS(title) EQ 0) then $
- title = ''
- if (N_ELEMENTS(wGroup) EQ 0) then $
- wGroup = 0L
-
- sizeData = N_ELEMENTS(data) ; Determine # of data elements
- if (sizeData EQ 0) then $ ; abort if there is no data.
- RETURN, 0L
- if (sizeData EQ 1) then $
- tmpData = REPLICATE(STRTRIM(STRING(data)),1) $
- else $
- tmpData = STRTRIM(STRING(REFORM(data,sizeData,1)),2)
-
- ; The data is to be displayed in a 7 column table widget.
- ; If needed, the data is padded with blanks to create a
- ; rectangular table which is compatible with IDL's table
- ; widget.
- ;
- cols = 7
- rows = sizeData / cols
- left = sizeData mod cols
- if left GT 0 then begin
- add = StrArr(cols-left)
- tmpData = [tmpData,add]
- tmpData = REFORM(tmpData, cols, rows+1)
- endif else $
- tmpData = REFORM(tmpData, cols, rows)
-
- ; Create the Widget with a scrolling table widget depending on
- ; the number of rows.
- ;
- wTLB = WIDGET_BASE(TITLE = title,$
- GROUP_LEADER = wGroup, /BASE_ALIGN_CENTER, /COLUMN)
- if (rows gt 8) then $
- wTable = WIDGET_TABLE(wTLB, VALUE = tmpData, /NO_HEADERS, XSIZE = cols, $
- /SCROLL) $
- else $
- wTable = WIDGET_TABLE(wTLB, VALUE = tmpData, /NO_HEADERS, XSIZE = cols)
-
- wButton = WIDGET_BUTTON(wTLB, VALUE = 'Close')
-
- ; Realize the Data Viewer and register the widget with XManager
- ;
- WIDGET_CONTROL, wTLB, /Realize
- XMANAGER, 'DataViewer: ' + title, wTLB, EVENT_HANDLER = 'DataViewerHandler', $
- /NO_BLOCK
-
- ; Return the ID of the widget's top level base.
- ;
- RETURN, wTLB
- end
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Determine the IDL data type of value.
- ;
- function TypeOf, $
- value ; IN: value
-
- type = (SIZE(value))[(SIZE(value))[0]+1]
- case type of
- 0: typeStr = 'undefined'
- 1: typeStr = 'byte'
- 2: typeStr = 'integer'
- 3: typeStr = 'long integer'
- 4: typeStr = 'float'
- 5: typeStr = 'double'
- 6: typeStr = 'complex'
- 7: typeStr = 'double complex'
- 8: typeStr = 'string'
- endcase
- RETURN, typeStr
-
- end
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Determine whether or not the set is compatible
- ; with the Venn Demo program.
- ;
- function ValidSetData, $
- set ; IN: data set
-
- if ((TypeOf(set) EQ 'integer') OR $
- (TypeOf(set) EQ 'long integer') OR $
- (TypeOf(set) EQ 'byte')) then $
- RETURN, 1B $
- else $
- RETURN, 0B
- end
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Define the bitmaps buttons for the Set Calculator
- ;
- pro LoadCalcBitmaps, $
- bmDelete, $ ; OUT: Delete button
- bmClear, $ ; OUT: Clear button
- bmIntersect, $ ; OUT: Intersect button
- bmUnion, $ ; OUT: Union button
- bmSubtract, $ ; OUT: Subtract button
- bmEnter ; OUT: Enter button
-
- bmDelete = BYTE( $
- [[ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0], $
- [ 0, 0, 0], [128, 0, 0], [192, 0, 0], $
- [224, 0, 0], [240, 0, 0], [248, 255, 0], $
- [252, 255, 0], [248, 255, 0], [240, 0, 0], $
- [224, 0, 0], [192, 0, 0], [128, 0, 0], $
- [ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0]])
-
- bmClear = BYTE( $
- [[ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0], $
- [ 0, 0, 0], [ 0, 0, 0], [248, 124, 0], $
- [252, 124, 0], [ 12, 12, 0], [ 6, 12, 0], $
- [ 6, 124, 0], [ 6, 124, 0], [ 6, 12, 0], $
- [ 12, 12, 0], [252, 124, 0], [248, 124, 0], $
- [ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0]])
-
- bmIntersect = BYTE( $
- [[ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0], $
- [ 0, 0, 0], [192, 7, 0], [224, 15, 0], $
- [112, 28, 0], [ 56, 56, 0], [ 24, 48, 0], $
- [ 24, 48, 0], [ 24, 48, 0], [ 24, 48, 0], $
- [ 24, 48, 0], [ 24, 48, 0], [ 24, 48, 0], $
- [ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0]])
-
- bmUnion = BYTE( $
- [[ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0], $
- [ 0, 0, 0], [ 24, 48, 0], [ 24, 48, 0], $
- [ 24, 48, 0], [ 24, 48, 0], [ 24, 48, 0], $
- [ 24, 48, 0], [ 24, 48, 0], [ 24, 48, 0], $
- [ 56, 56, 0], [112, 28, 0], [ 224, 15, 0], $
- [192, 7, 0], [ 0, 0, 0], [ 0, 0, 0]])
-
- bmSubtract = BYTE( $
- [[ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0], $
- [ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0], $
- [ 0, 0, 0], [ 0, 0, 0], [252, 127, 0], $
- [252, 127, 0], [ 0, 0, 0], [ 0, 0, 0], $
- [ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0], $
- [ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0]])
-
- bmEnter = BYTE( $
- [[ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0], $
- [ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0], $
- [252, 127, 0], [252, 127, 0], [ 0, 0, 0], $
- [ 0, 0, 0], [252, 127, 0], [252, 127, 0], $
- [ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0], $
- [ 0, 0, 0], [ 0, 0, 0], [ 0, 0, 0]])
- end
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Creates an instance of the 'sets' class and
- ; and updates the Venn Demo GUI as needed.
- ;
- ; Side Effects: Creates a new 'sets' object,sensitizes a widget
- ; button on the calculator GUI, and adds a menu item
- ; to the 'View set data' menu.
- ;
- pro CreateSet, $
- wSetButton, $ ; IN: Set button ID
- wDataButton, $ ; IN: View Set Data menu button ID.
- numSets, $ ; IN/OUT: number of sets
- oSetList, $ ; IN/OUT: set array list
- setNames, $ ; IN/OUT: array list of set names
- DATA=data, $ ; IN: (opt) Data of the set
- SEED = seed ; IN: (opt) Seed for random generation of data
-
- ; If no data is passed in then the set data will be generated
- ;
- if (N_ELEMENTS(data) EQ 0) then $
- data = FIX(RANDOMN(seed,(ROUND(RANDOMU(seed)*100)>1))*RANDOMU(seed)*100)
-
- numSets = numSets + 1
-
- ; Create the set, sensitize the button on the Set Calculator, and
- ; add the set to the 'View set data' menu.
- ;
- name = STRING(64B + BYTE(numSets))
- oSet = OBJ_NEW('sets', name, data)
- setNames[numSets-1] = 'Set ' + name
- oSetList[numSets-1] = oSet
- WIDGET_CONTROL, wSetButton, SENSITIVE = 1
- WIDGET_CONTROL, wDataButton, SENSITIVE = 1
-
- end
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: This function calls the appropriate set operation routine.
- ; It performs :
- ;
- ; (Set A) operation (Set B) = (Set C)
- ;
- ; The resulting data (Set C), number of elements
- ; in the result, and the number of common elements is returned.
- ;
- function DoSetOp, $
- a, b, $ ; IN: Sets A and B
- op, $ ; IN: Set operator (intersect, subtract, or union)
- Count=count, $ ; OUT: (opt) number of data in set C
- Intersect_Size = iSize ; OUT: (opt) size of set C
-
- FORWARD_FUNCTION SetsIntersect, SetsSubtract, SetsUnion
-
- case op of
-
- 'Intersection': begin
- c = SetsIntersect(a, b, Count = count)
- iSize = count
- end
-
- 'Subtraction': c = SetsSubtract(a, b, $
- Count=count, Intersect_Size=iSize)
-
- 'Union': c = SetsUnion(a, b, $
- Count=count, Intersect_Size=iSize)
-
- endcase
-
- RETURN, c
- end
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Modify the calculator's text box based on the 'action'
- ; argument.
- ;
- ; Side Effects: XYOUTS text to the calculator's text box.
- ;
- function ModifyCalcText, $
- calcText, $ ; IN/OUT: calculator text
- gTextBox, $ ; IN: Calculator window ID
- flag, $ ; IN/OUT:
- action, $ ; IN: Operation (intersection, subtraction, or union)
- set, $ ; IN: Set object
- COLOR=color ; IN: (opt) color of the calculator text box
-
- if (N_ELEMENTS(color) EQ 0) then $
- color = 0
-
- ; Make the Calculator text box the active display, and determine the
- ; sizing information
- ;
- WSET, gTextBox
- width = !D.X_SIZE
- height = !D.Y_SIZE
- xCharSize = !D.X_CH_SIZE
- yCharSize = !D.Y_CH_SIZE
-
- case action of
- 'CLEAR': begin
- calcText = ''
- flag = 0
- end
-
- 'DELETE': begin
- if (flag gt 0) then begin
- flag = flag - 1
- calcText = STRMID(calcText,0,(STRLEN(calcText)-3))
- endif else $
- flag = 0
- end
-
- 'ADD_SET': begin
- set -> GetProperty, Name = newText
- calcText = calcText + '!3' + newText
- flag = flag + 1
- end
-
- else: begin
- if (flag EQ 1) then begin
-
- case action of
- 'Intersection': newText = '!93'
- 'Subtraction': newText = '!3-'
- 'Union': newText = '!91'
- endcase
-
- flag = flag + 1
- calcText = calcText + newText
-
- endif else $
- RETURN, 0b
- end
- endcase
-
- ; Erase, and redraw the new text.
- ;
- ERASE
- XYOUTS, width - (xCharSize*flag)-10, $
- height*.3, calcText, COLOR = color, /DEVICE
-
- RETURN, 1B
- end
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Event handling procedure for Set Calculator's
- ; individual set buttons.
- ; Side Effects: Updates the structure sState and the GUI.
- ;
- pro SetCalcButtonHandleEvents, $
- sEvent ; IN: event structure
-
- ; Obtain the state structure which is store in the demo's top level base.
- ;
- WIDGET_CONTROL, sEvent.top, GET_UVALUE = sState, /NO_COPY
-
- ; Obtain the user value of the widget which produced the event.
- ;
- WIDGET_CONTROL, sEvent.id, GET_UVALUE = userValue
-
- if (TAG_NAMES(sEvent, /STRUCTURE) EQ 'WIDGET_TRACKING') then begin
- WIDGET_CONTROL, sState.wTipsBox, SET_VALUE= $
- 'Press one of these buttons to add a given set to the calculation.'
-
- endif else begin
-
- ; Make a local copy of the calculator flag.
- ; 0 - nothing in the calculator text area
- ; 1 - the first set has been selected
- ; 2 - the first set and the set operator has been selected
- ; 3 - both sets and the operator has been selected
- ;
- calcFlag = sState.calcFlag
- setCalcText = sState.setCalcText
-
- ; If the calculator is ready for a set to be selected then do this.
- ;
- if calcFlag EQ 0 or calcFlag EQ 2 then begin
- case calcFlag of
- 0: sState.set1 = sState.oSetList[userValue] ; Set to 1st operand
- 2: sState.set2 = sState.oSetList[userValue] ; Set to 2nd operand
- endcase
-
- ; Modify the Calculator text boxes and update the calculator flag.
- ;
- if ModifyCalcText(setCalcText, sState.gCalcTextBox, calcFlag, $
- 'ADD_SET', sState.oSetList[userValue]) then begin
- sState.calcFlag = calcFlag
- sState.setCalcText = setCalcText
- endif
- endif
- endelse
-
- ; Store the state structure back in the top level base's user value.
- ;
- WIDGET_CONTROL, sEvent.top, SET_UVALUE = sState, /NO_COPY
- end
-
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Event handling procedure for the Set Calculator
- ; excluding the individual set buttons.
- ;
- ; Side Effects: Updates the structure sState and the GUI.
- ;
- pro SetCalcHandleEvents, $
- sEvent ; IN: Event structure.
-
-
- WIDGET_CONTROL, sEvent.top, Get_UVALUE = sState, /NO_COPY
- WIDGET_CONTROL, sEvent.id, Get_UVALUE = uVal
-
- ; Check for a Tracking event and update the Tips boxes as needed.
- ;
- if (TAG_NAMES(sEvent, /STRUCTURE) EQ 'WIDGET_TRACKING') then begin
- if (N_ELEMENTS(uVal) NE 0) then begin
-
- case uVal of
-
- 'Intersection': begin
- tipText = 'Choose this button to perform a set Intersection.'
- end
-
- 'Union': begin
- tipText = 'Choose this button to perform a set Union.
- end
-
- 'Subtraction': begin
- tipText = 'Choose this button to perform a set Subtraction.'
- end
-
- 'CLEAR': begin
- tipText = 'Clear the calculator.'
- end
-
- 'DELETE': begin
- tipText = 'Erase the last calculator entry.'
- end
-
- 'ENTER': begin
- tipText = 'Press this button to accept the current set calculation.'
- end
-
- 'CALC_TEXT': begin
- tipText = 'This box shows the current set operation as it is typed.'
- end
-
- endcase
-
- endif else tipText = ''
-
- WIDGET_CONTROL, sState.wTipsBox, SET_VALUE = tipText
-
- endif else begin
-
- ; All other events are separated between an 'ENTER' event
- ; and all the rest. The non-enter events only update the
- ; Calculator Text box and certain flags.
- ;
- if (uVal ne 'ENTER') then begin
- calcFlag = sState.calcFlag
- setCalcText = sState.setCalcText
-
- if ModifyCalcText(setCalcText, sState.gCalcTextBox, $
- calcFlag, uVal) then begin
-
- ; If the event was from an set operation button
- ; then store the op.
- ;
- if ((calcFlag EQ 2) AND (calcFlag gt sState.calcFlag)) then $
- sState.op = uVal
- sState.calcFlag = calcFlag
- sState.setCalcText = setCalcText
- endif
-
- endif else begin
-
- ; This is an 'ENTER' event-- the equal button was pressed.
- ;
- if (sState.calcFlag EQ 3) then begin
- if sState.numSets EQ sState.maxSets then $
- void = $
- DIALOG_MESSAGE('Too many sets. Please Restart this demo.') $
-
- else begin
-
- ; Get the data, names, and sizes of sets.
- ;
- sState.set1 -> GetProperty, DATA=set1Data, SIZE= $
- set1Size, NAME=set1Name
- sState.set2 -> GetProperty, DATA=set2Data, SIZE=$
- set2Size, NAME=set2Name
-
- ; Perform the set operation and return the result.
- ;
- newData = DoSetOp( set1Data, set2Data, sState.op, $
- COUNT=setSize, INTERSECT_SIZE=iSize)
-
- ; Determine Name of new Set.
- ;
- name = STRING(BYTE(sState.numSets) + 65b )
-
- ; Create a new set object.
- ;
- if setSize EQ 0 then $
- newSet = OBJ_NEW('sets', name, $
- SET1_SIZE=set1Size, SET2_SIZE=set2Size, $
- OP=sState.op, SET1_NAME=set1Name, $
- SET2_NAME=set2Name) $
- else $
- newSet = OBJ_NEW('sets', name, newData, $
- SET1_SIZE=set1Size, SET2_SIZE=set2Size, $
- OP=sState.op, SET1_NAME=set1Name, $
- SET2_NAME=set2Name)
-
- ; Update the available set information.
- ;
- sState.numSets = sState.numSets + 1
- sState.oSetList[sState.numSets-1] = newSet
- sState.setNames[sState.numSets-1] = 'Set ' + name
-
- ; Update the GUI.
- ;
- WIDGET_CONTROL, sState.wCurrentSet, SET_VALUE = $
- sState.setNames[0:sState.numSets-1]
-
- WIDGET_CONTROL, sState.wCurrentSet, SET_DROPLIST_SELECT = $
- sState.numSets-1
-
- WIDGET_CONTROL, sState.wSetButtons[sState.numSets-1], $
- SENSITIVE = 1
-
- WIDGET_CONTROL, sState.wDataButtons[sState.numSets-1], $
- SENSITIVE = 1
-
- newSet->GetProperty, DESC = desc
-
- WIDGET_CONTROL, sState.wDescText, SET_VALUE = desc
-
- WIDGET_CONTROL, sState.wDescTitle, SET_VALUE = $
- 'Venn Diagram: Set ' + name
-
-
- DrawVennDiagram, set1Size, set2Size, setSize, set1Name, $
- set2Name, name, sState.op, sState.gVennArea, $
- COLORS = sState.colors
-
- result = ModifyCalcText(sState.setCalcText, $
- sState.gCalcTextBox, calcFlag,'CLEAR')
-
- sState.calcFlag = 0
- sState.setCalcText = ''
-
- endelse
- endif else $
- result = DIALOG_MESSAGE('Not a valid set operation.')
- endelse
- endelse
-
- WIDGET_CONTROL, sEvent.top, Set_UValue = sState, /NO_COPY
-
- end
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Cleanup proceduire for Venn
- ;
- ; Side Effects: Removes heap variables, and restores color settings
- ;
- pro CleanUpVenn, $
- wTop ; IN: Top level base
-
- ; Get the color table saved in the window's user value.
- ;
- WIDGET_CONTROL, wTop, GET_UVALUE = sState, /NO_COPY
-
- ; Restore the previous color table and background system variable.
- ;
- TVLCT, sState.colorTable
- !P.BACKGROUND = sState.backgroundSave
-
- ; Check for validity of existing Sets Objects and destroy them.
- ;
- if OBJ_VALID(sState.set1) then $
- OBJ_DESTROY, sState.set1
- if OBJ_VALID(sState.set2) then $
- OBJ_DESTROY, sState.set2
- OBJ_DESTROY, sState.oSetList
-
- if WIDGET_INFO(sState.groupBase, /VALID_ID) then $
- WIDGET_CONTROL, sState.groupBase, /MAP
-
- end ; of CleanupVenn
-
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Main event handling routine for the Venn Demo.
- ;
- ; Side Effects: Updates sState, could display a Data Viewer, and modify
- ; the GUI.
- ;
- pro VennHandleEvents, $
- sEvent ; IN: event structure
-
- ; Quit the application using the close box.
- ;
- if (TAG_NAMES(sEvent, /STRUCTURE_NAME) EQ $
- 'WIDGET_KILL_REQUEST') then begin
- WIDGET_CONTROL, sEvent.top, /DESTROY
- RETURN
- endif
-
-
- WIDGET_CONTROL, sEvent.top, GET_UVALUE = sState, /No_Copy
- WIDGET_CONTROL, sEvent.id, GET_UVALUE = uVal
-
- if (TAG_NAMES(sEvent, /STRUCTURE) EQ 'WIDGET_TRACKING') then begin
-
- if (N_ELEMENTS(uVal) NE 0) then begin
-
- case uVal of
-
- 'CURRENT': begin
- tipText = 'Select a set from this droplist' + $
- ' to view its Venn Diagram and description.'
- end
-
- 'DESC': begin
- tipText = 'This is a description of the set' + $
- ' you are currently viewing.'
- end
-
- 'VENN': begin
- tipText = 'This is the Venn diagram for the' + $
- ' set you are currently viewing.'
- end
-
- else: tipText = ''
-
- endcase
-
- endif else tipText = ''
-
- WIDGET_CONTROL, sState.wTipsBox, SET_VALUE = tipText
-
- endif else begin
-
- case uVal of
-
- 'CURRENT': begin
- sState.oSetList[sEvent.index]->GetProperty, $
- DESC=desc, NAME=name, $
- OP=op, SET1_NAME=set1Name, SET2_NAME=set2Name, $
- SET1_SIZE=set1Size, SET2_SIZE=set2Size, SIZE=size
-
- WIDGET_CONTROL, sState.wDescTitle, $
- SET_VALUE='Venn Diagram: Set ' + name
-
- DrawVennDiagram, set1Size, set2Size, size, set1Name, $
- set2Name, name, op, sState.gVennArea, $
- COLORS = sState.colors
-
- WIDGET_CONTROL, sState.wDescText, SET_VALUE = desc
- end
-
- 'HELP' : begin
-
- ; Display the 'online help' for this demo.
- ;
- if( Xregistered('XDisplayFile') NE 0) then RETURN
- XDisplayFile, filepath('venn.txt', $
- SUBDIR = ['examples','demo','demotext']), $
- DONE_BUTTON='Done', $
- TITLE="About Venn Demo" , $
- GROUP=sEvent.top, WIDTH=55, HEIGHT=14
-
- end ; of Help
-
- 'QUIT' : begin
- WIDGET_CONTROL, sEvent.top, SET_UVALUE = sState, /NO_COPY
- WIDGET_CONTROL, sEvent.top, /DESTROY
- RETURN
- end
-
- else: begin
-
- ; Display the given set's data if it is not already displayed.
- ; If it is displayed then bring it to the front.
- ;
- index = WHERE(uVal EQ sState.setNames, count)
-
- if (count NE 0) then begin
- if WIDGET_INFO(sState.wDataViewers[index], $
- /VALID_ID) then $
- WIDGET_CONTROL, sState.wDataViewers[index], /SHOW $
- else begin
- oSet = sState.oSetList[index]
- oSet->GetProperty, DATA = data, NAME = name
-
- if (N_ELEMENTS(data) EQ 0) then $
- junk = DIALOG_MESSAGE('This is the Empty set', $
- TITLE = 'Set ' + name, /INFORMATION) $
- else $
- sState.wDataViewers[index] = DataViewer(data, $
- TITLE = 'Set '+ name, GROUP_LEADER = sEvent.top)
- endelse
- endif
-
- end ; of else
-
- endcase
-
- endelse
-
- WIDGET_CONTROL, sEvent.top, SET_UVALUE = sState, /NO_COPY
- end
-
- ;----------------------------------------------------------------------------
- ;
- ; PURPOSE: Main procedure of the Venn demo
- ;
- pro D_Venn, $
- set1, set2, set3, set4, set5, set6, $ ; IN: sets objects
- GROUP=group, $ ; IN: (opt) group identifier
- APPTLB = appTLB ; OUT: (opt) TLB of this application
-
- ; Check for the proper # of arguments.
- ;
- if (N_PARAMS() GT 6) then $
- MESSAGE, 'Called with too many arguments.'
-
- ; Check the validity of the group identifier.
- ;
- ngroup = N_ELEMENTS(group)
- if (ngroup NE 0) then begin
- check = WIDGET_INFO(group, /VALID_ID)
- if (check NE 1) then begin
- print,'Error, the group identifier is not valid'
- print, 'Return to the main application'
- RETURN
- endif
- groupBase = group
- endif else groupBase = 0L
-
- ; Get the current color vectors to restore
- ; when this application is exited.
- ;
- TVLCT, savedR, savedG, savedB, /GET
-
- ; Build color table from color vectors.
- ;
- colorTable = [[savedR],[savedG],[savedB]]
-
- ; Create the starting up message.
- ;
- if (ngroup EQ 0) then begin
- drawbase = startmes()
- endif else begin
- drawbase = startmes(GROUP=group)
- endelse
-
- ; If possible, force the system to use 256 colors.
- ;
- if((( !D.NAME EQ 'X') OR (!D.NAME EQ 'MAC')) $
- AND (!D.N_COLORS GE 256L)) then $
- DEVICE, PSEUDO_COLOR = 8
-
- DEVICE, DECOMPOSED = 0, BYPASS_TRANSLATION = 0
-
-
- ; Set up a Tek Color Table.
- ;
- TEK_COLOR
- colors = INTARR(32)
- colors[0] = 4 ;Set result color to blue
- colors[1] = 2 ;Set set A color to red
- colors[2] = 3 ;Set set B color to green
- colors[3] = 0 ;Set text color to black
- colors[4] = 1 ;Set background to white
-
- ; Save incoming and set the background to white.
- ;
- backgroundSave = !P.BACKGROUND
- !P.BACKGROUND = colors[4]
-
- ; Load the calculator bitmap buttons.
- ;
- LoadCalcBitmaps, bmDelete, bmClear, bmIntersect, $
- bmUnion, bmSubtract, bmEnter
-
- ; Allow for only 15 available sets.
- ;
- maxSets = 15
-
- ; Define a main widget base.
- ;
- if (N_ELEMENTS(group) EQ 0) then begin
- wTop = WIDGET_BASE(TITLE="Venn Demo", /COLUMN, $
- MAP=0, $
- /TLB_KILL_REQUEST_EVENTS, $
- TLB_FRAME_ATTR = 1, Mbar = wMenuBar)
- endif else begin
- wTop = WIDGET_BASE(TITLE="Venn Demo", /COLUMN, $
- MAP=0, $
- /TLB_KILL_REQUEST_EVENTS, $
- TLB_FRAME_ATTR = 1, Mbar = wMenuBar, $
- GROUP_LEADER=group)
- endelse
-
- appTlb = wTop
-
- ; Create the menu bar item file that contains the exit button.
- ;
- wFileMenu = WIDGET_BUTTON(wMenuBar, VALUE='File', /MENU)
-
- wQuitItem = WIDGET_BUTTON(wFileMenu, VALUE='Quit', UVALUE='QUIT')
-
- ; Create Options Menu
- ;
- wOptionsMenu = WIDGET_BUTTON(wMenuBar, VALUE='Options', /MENU)
-
- wDataMenu = WIDGET_BUTTON(wOptionsMenu, $
- VALUE='View Set Data' ,/MENU)
- wDataButtons = LONARR(maxSets)
- for i = 0, maxSets-1 do begin
- name = STRING(65B + BYTE(i))
- wDataButtons[i] = WIDGET_BUTTON(wDataMenu, VALUE = $
- 'Set '+ name, UVALUE = 'Set '+ name)
- WIDGET_CONTROL, wDataButtons[i], SENSITIVE = 0
- endfor
-
- ; Create Help Menu
- ;
- wHelpMenu = WIDGET_BUTTON(wMenuBar, VALUE='About', /HELP, /MENU)
-
- wHelpItem = WIDGET_BUTTON(wHelpMenu, $
- VALUE='About Venn Demo...', UVALUE='HELP')
-
- ; Create the first child of the top level base(wTop).
- ;
- wTopRowBase = WIDGET_BASE(wTop, Column = 2,/Frame, /TRACK)
-
- ; Create a base for the left column.
- ;
- wLeftBase = WIDGET_BASE(wTopRowBase,/BASE_ALIGN_CENTER, $
- Column=1, /TRACK)
-
- ; Calculator.
- ;
- wSetCalcTitle = WIDGET_LABEL(wLeftBase, $
- VALUE='Set Calculator', /TRACK)
-
- wSetCalcBase = WIDGET_BASE(wLeftBase, /COLUMN , /FRAME, $
- /BASE_ALIGN_RIGHT, /TRACK)
- wSetCalcText = LONARR(3)
-
- wSetCalcTextBase = WIDGET_BASE(wSetCalcBase, /ROW, /TRACK, $
- EVENT_PRO = 'SetCalcHandleEvents')
-
- wSetCalcTextBox = WIDGET_DRAW(wSetCalcTextBase, $
- UVALUE = 'CALC_TEXT', $
- XSIZE = 100, YSIZE = 25, RETAIN = 2, /TRACKING_EVENTS)
-
- wCalcDeleteButton = WIDGET_BUTTON(wSetCalcTextBase, $
- VALUE = bmDelete, /TRACKING_EVENTS, UVALUE = 'DELETE')
-
- wButtonsBase = WIDGET_BASE(wSetCalcBase, $
- UVALUE='BUTTONS', /ROW, /TRACK)
-
- wSetButtonsBase = WIDGET_BASE(wButtonsBase, $
- /GRID_LAYOUT, ROW=5, /TRACKING_EVENTS, $
- EVENT_PRO='SetCalcButtonHandleEvents')
-
- wSetButtons = LONARR(maxSets)
-
- for i = 0B, 14B do begin
- wSetButtons[i] = WIDGET_BUTTON(wSetButtonsBase, $
- FONT = calcTextFont, $
- VALUE=STRING(65B+i), /TRACKING_EVENTS, $
- UVALUE = i)
- WIDGET_CONTROL, wSetButtons[i], SENSITIVE = 0
- endfor
-
- wOpsButtonsBase = WIDGET_BASE(wButtonsBase, /TRACK, $
- /GRID_LAYOUT, ROW=5, EVENT_PRO='SetCalcHandleEvents')
-
- wClearButton = WIDGET_BUTTON(wOpsButtonsBase, $
- VALUE=bmClear, UVALUE='CLEAR', $
- /TRACKING_EVENTS)
-
- wIntersectButton = WIDGET_BUTTON(wOpsButtonsBase, $
- VALUE=bmIntersect, UVALUE='Intersection', $
- /TRACKING_EVENTS)
-
- wSubtractButton = WIDGET_BUTTON(wOpsButtonsBase, $
- VALUE = bmSubtract, $
- UVALUE = 'Subtraction', /TRACKING_EVENTS)
-
- wUnionButton = WIDGET_BUTTON(wOpsButtonsBase, $
- VALUE=bmUnion, UVALUE='Union', $
- /TRACKING_EVENTS)
-
- wEnterButton = WIDGET_BUTTON(wOpsButtonsBase, $
- VALUE=bmEnter, UVALUE='ENTER', $
- /TRACKING_EVENTS)
-
- wCurrentSetBase = WIDGET_BASE(wLeftBase, /COLUMN, /TRACK)
-
- wCurrentSet = WIDGET_DROPLIST(wCurrentSetBase, $
- VALUE='', /DYNAMIC_RESIZE, $
- TITLE='Currently Viewing: ', $
- UVALUE = 'CURRENT', /TRACKING_EVENTS)
-
- wRightBase = WIDGET_BASE(wTopRowBase, /COLUMN, /TRACK)
-
- wDescTitle = WIDGET_LABEL(wRightBase, /TRACK, $
- VALUE='Venn Diagram: Set A', /ALIGN_CENTER, XSIZE=250)
-
- ; Create the drawing area for the Venn diagram.
- ;
- text = ['Set A contains 34 integers.' + $
- ' The minimum is -34 and the maximum is 56.']
-
- wVennDraw = WIDGET_DRAW(wRightBase, XSIZE=300,$
- YSIZE=250, RETAIN=2, UVALUE='VENN', /TRACKING_EVENTS)
-
- wDescText = WIDGET_TEXT(wRightBase, VALUE=text, YSIZE=4, $
- SCR_XSIZE=250, /WRAP, /TRACKING_EVENTS, UVALUE='DESC')
-
- ; Create the second child of the top level base(wTop)
- ; This is the status window
- ;
- wBottomRowBase = WIDGET_BASE(wTop, /ROW)
-
- ; Create the widget label of the status window.
- ;
- widthTips = 72
- wTipsBox = WIDGET_TEXT(wBottomRowBase, $
- xsize = widthTips, ysize=1, $
- value = string(replicate(32b, widthTips)))
-
-
- ; Initialize the set arrays and counter variable.
- ;
- numSets = 0
- oSetList = OBJARR(maxSets)
- setNames = STRARR(maxSets)
-
- ; Determine if the user passed in set data to the Venn demo.
- ; If the data is valid, then add a set and modify the GUI.
- ;
- count = 1
- index = 0
- while (count LE N_PARAMS()) do begin
-
- case count of
- 1: tmpData = set1
- 2: tmpData = set2
- 3: tmpData = set3
- 4: tmpData = set4
- 5: tmpData = set5
- 6: tmpData = set6
- endcase
-
- if (ValidSetData(tmpData)) then begin
- CreateSet, wSetButtons[index], wDataButtons[index], numSets, oSetList, $
- setNames, DATA = tmpData
- index = index + 1
- endif
-
- count = count + 1
-
- endwhile
-
- ; Guarantee at least two sets are loaded.
- ;
- if (index LT 2) then $
- for i = index,1 do $
- CreateSet, wSetButtons[i], wDataButtons[i], numSets, oSetList, $
- setNames, SEED=seed
-
- ; Realize the widget hierarchy.
- ;
- WIDGET_CONTROL, wTop, /REALIZE
-
- ; Store all the currently available Set names in the Viewing Droplist.
- ;
- WIDGET_CONTROL, wCurrentSet, SET_VALUE = setNames[0:numSets-1]
-
- ; Obtain the id of the Venn drawing area and the Set Calculator Text area.
- ; Also draw the background as White.
- ;
- WIDGET_CONTROL, wVennDraw, GET_VALUE=gVennArea
- WIDGET_CONTROL, wSetCalcTextBox, GET_VALUE=gCalcTextBox
- WSET, gCalcTextBox
- ERASE
- WSET, gVennArea
- ERASE
-
- ; Update GUI to display information for first Set.
- ;
- setIndex = 0
- oSetList[setIndex]->GetProperty, DESC=desc, NAME=name, SIZE=size
- WIDGET_CONTROL, wDescTitle, SET_VALUE='Venn Diagram: Set ' + name
- DrawVennDiagram, 0, 0, size, '', '', name, '', gVennArea, COLORS=colors
- WIDGET_CONTROL, wDescText, SET_VALUE=desc
-
- ; Now that the GUI is completely initialize, we will map it to the screen
- ;WIDGET_CONTROL, wTop, UPDATE = 1
-
- ; Initialize the state structure.
- ; This holds all the information used for this Demo.
- ;
- state={ $
- colorTable: colorTable, $ ; Original Color Table
- backgroundSave: backgroundSave, $ ; Original !P.BACKGROUND
- wDataButtons:wDataButtons, $ ; IDs of View set data buttons
- wLeftBase: wLeftBase, $ ; ID of Calculator Base
- setCalcText: '', $ ; Current calculator text
- wSetButtonsBase:wSetButtonsBase, $ ; ID of base for Calculator set buttons
- wSetButtons:wSetButtons, $ ; IDs of all the set buttons
- wDescTitle:wDescTitle, $ ; ID of Venn Diagram Title
- wDescText:wDescText , $ ; ID of text widget holding
- ; Set descriptions
- wCurrentSet:wCurrentSet, $ ; ID of Viewing Current droplist
- setNames:setNames, $ ; Current list of Set names
- gVennArea: gVennArea, $ ; Graphics window ID of the Venn Diagram
- gCalcTextBox:gCalcTextBox, $ ; Graphics window ID of Calculator text
- wTipsBox : wTipsBox, $ ; IDs of the Tips text boxes
- calcFlag:0B , $ ; Flag to indicate calculator status
- set1 : OBJ_NEW('sets'), $ ; First Set used in the set operation
- set2 : OBJ_NEW('sets'), $ ; Second Set used in the set operation
- colors: colors, $ ; The current colors for displaying
- ; The Venn Diagram
- op : '', $ ; Flag denoting Set Operation
- ; 0 - Minus , 1 - Intersection,
- ; 2 - Union
- setIndex:setIndex, $ ; Index of currently viewed set
- numSets:numSets, $ ; Total # of available sets
- maxSets: maxSets, $ ; Maximum # of sets possible
- oSetList: oSetList, $ ; Array of 20 Set Objects
- wDataViewers:LONARR(maxSets), $ ; IDs of individual Data Viewers
- groupBase: groupBase $ ; Base of Group Leader
- }
-
-
-
- ; Register the info structure in the user value of the top-level base
- ;
- WIDGET_CONTROL, wTop, SET_UVALUE=state, /NO_COPY
-
- ; Destroy the starting up window.
- ;
- WIDGET_CONTROL, drawbase, /DESTROY
-
- ; Map the top level base.
- ;
- WIDGET_CONTROL, wTop, MAP=1
-
- ; Register with the XMANAGER.
- ;
- XMANAGER, 'D_Venn', wTop, $
- EVENT_HANDLER = 'VennHandleEvents', $
- /NO_BLOCK, CLEANUP = 'CleanUpVenn'
-
- end ; D_Venn
-